さすらいのプログラマ

'
' CCalendar
'
' カレンダークラス
'
' 指定された年のカレンダーを持つ。
' 平日・土日・祝日・振替休日・国民の休日を調べることができる。
'
' 2009/03/17 作成
'
' History :
'   2009/03/17 初版
'
Option Explicit

'属性値
Private Const STATE_WEEKDAY                     As Integer = 0
Private Const STATE_SATURDAY                    As Integer = 1
Private Const STATE_SUNDAY                      As Integer = 2
Private Const STATE_HOLIDAY                     As Integer = 4
Private Const STATE_ALTERNATE                   As Integer = 8
Private Const STATE_NATIONAL_HOLIDAY            As Integer = 16
Private Const STATE_USER_HOLIDAY                As Integer = 32

Private Const STATE_CHECK_HOLIDAY               As Integer = (STATE_HOLIDAY Or STATE_SUNDAY)

'祝日タイプ  0:日付固定 1:月の何番目の曜日指定(例:第３月曜)
Private Const TYPE_FIX_HOLIDAY                  As Integer = 0
Private Const TYPE_VAR_HOLIDAY                  As Integer = 1

'メンバー変数
Private m_DayTable() As Integer                              '１年分のテーブル（属性テーブル）
Private m_Year As Integer                                    '設定年
Private m_Base As Double                                     'テーブル位置を加算すると日付が算出される。

'祝日設定アイテム
Private Type DAYITEM
    m_Type As Integer                                        '祝日タイプ
    m_Month As Integer                                       '月
    m_Day As Integer                                         '日付または、何番目
    m_Week As Integer                                        '曜日（祝日タイプが0:日付固定の場合は、使われない）
End Type

Private m_DayItems() As DAYITEM                              '祝日設定テーブル

Public Property Let Year(nYear As Integer)
    Dim firstDate As Date
    
    '年の設定
    m_Year = nYear
    firstDate = m_Year & "/01/01"                            '１月１日を作成し、前日をベース日付とする。
    firstDate = firstDate - 1
    m_Base = firstDate
    'カレンダーテーブルの初期化
    Call InitCalendar
End Property

Private Sub Class_Initialize()
    '年を未設定にする
    m_Year = -1
End Sub

Private Sub InitCalendar()
    Dim i As Long
    Dim TargetDate As Date
    
    'テーブルの設定（日付分準備する）
    If IsLeapYear() Then
        ReDim m_DayTable(1 To 366)
    Else
        ReDim m_DayTable(1 To 365)
    End If
    '平日・土曜・日曜設定
    For i = LBound(m_DayTable) To UBound(m_DayTable)
        TargetDate = m_Base + i                              'ベース日付＋インデックスで日付を算出
        Select Case Weekday(TargetDate)
        Case vbSunday
            m_DayTable(i) = STATE_SUNDAY
        Case vbSaturday
            m_DayTable(i) = STATE_SATURDAY
        Case Else
            m_DayTable(i) = STATE_WEEKDAY
        End Select
    Next i
    Call InitDayItem                                         '祝日設定テーブルの初期化
    Call SetHoliday                                          '祝日の設定
    Call SetAlternateHoliday                                 '振替休日の設定
    Call SetNationalHoliday                                  '国民の休日設定
End Sub

Private Sub InitDayItem()
    ReDim m_DayItems(0 To 14)
    
    '祝日の設定
    Call SetDayItem(m_DayItems(0), TYPE_FIX_HOLIDAY, 1, 1)                               '元日 1/1
    Call SetDayItem(m_DayItems(1), TYPE_VAR_HOLIDAY, 1, 2, vbMonday)                     '成人の日
    Call SetDayItem(m_DayItems(2), TYPE_FIX_HOLIDAY, 2, 11)                              '建国記念の日
    Call SetDayItem(m_DayItems(3), TYPE_FIX_HOLIDAY, 3, GetSpringDay(m_Year))            '春分の日
    Call SetDayItem(m_DayItems(4), TYPE_FIX_HOLIDAY, 4, 29)                              '昭和の日
    Call SetDayItem(m_DayItems(5), TYPE_FIX_HOLIDAY, 5, 3)                               '憲法記念日
    Call SetDayItem(m_DayItems(6), TYPE_FIX_HOLIDAY, 5, 4)                               'みどりの日
    Call SetDayItem(m_DayItems(7), TYPE_FIX_HOLIDAY, 5, 5)                               'こどもの日
    Call SetDayItem(m_DayItems(8), TYPE_VAR_HOLIDAY, 7, 3, vbMonday)                     '海の日
    Call SetDayItem(m_DayItems(9), TYPE_VAR_HOLIDAY, 9, 3, vbMonday)                     '敬老の日
    Call SetDayItem(m_DayItems(10), TYPE_FIX_HOLIDAY, 9, GetAutumnDay(m_Year))           '秋分の日
    Call SetDayItem(m_DayItems(11), TYPE_VAR_HOLIDAY, 10, 2, vbMonday)                   '体育の日
    Call SetDayItem(m_DayItems(12), TYPE_FIX_HOLIDAY, 11, 3)                             '文化の日
    Call SetDayItem(m_DayItems(13), TYPE_FIX_HOLIDAY, 11, 23)                            '勤労感謝の日
    Call SetDayItem(m_DayItems(14), TYPE_FIX_HOLIDAY, 12, 23)                            '天皇誕生日

End Sub

Private Sub SetDayItem(di As DAYITEM, nType As Integer, nMonth As Integer, nDay As Integer, Optional nWeek As Integer = 0)
    di.m_Type = nType                                        '祝日タイプ
    di.m_Month = nMonth                                      '月
    di.m_Day = nDay                                          '日付または、何番目
    di.m_Week = nWeek                                        '祝日タイプが1場合のみ有効
End Sub

Private Sub SetHoliday()
    Dim i As Long
    Dim TargetDate As Date
    Dim idx As Long
    Dim Count As Long
    
    For i = LBound(m_DayItems) To UBound(m_DayItems)
        Select Case m_DayItems(i).m_Type
        Case TYPE_FIX_HOLIDAY      '固定日付の休日
            '日付を生成する
            TargetDate = m_Year & "/" & m_DayItems(i).m_Month & "/" & m_DayItems(i).m_Day
            idx = TargetDate - m_Base                        'ベース日付分を引くとインデックスとなる。
            m_DayTable(idx) = m_DayTable(idx) Or STATE_HOLIDAY
        Case TYPE_VAR_HOLIDAY      '月の第？曜日
            '指定された月の１日の日付を生成する
            TargetDate = m_Year & "/" & m_DayItems(i).m_Month & "/1"
            Count = 0                                        '対象となる曜日のカウント
            Do While True
                If m_DayItems(i).m_Week = Weekday(TargetDate) Then
                    Count = Count + 1                        '対象となる曜日のカウント
                    If Count >= m_DayItems(i).m_Day Then
                        Exit Do
                    End If
                End If
                TargetDate = TargetDate + 1                  '次の日付
            Loop
            idx = TargetDate - m_Base
            m_DayTable(idx) = m_DayTable(idx) Or STATE_HOLIDAY
        End Select
    Next i
End Sub

Private Sub SetAlternateHoliday()
    Dim i As Long
    Dim j As Long
    Dim rc As Long
    
    For i = LBound(m_DayTable) To UBound(m_DayTable)
        rc = m_DayTable(i) And STATE_CHECK_HOLIDAY          '休日・日曜である日付の場合のみ処理
        If rc = STATE_CHECK_HOLIDAY Then
            '次の日付が休日でない場合まで進める。
            j = i + 1
            Do While m_DayTable(j) And STATE_HOLIDAY
                j = j + 1
            Loop
            '振替休日に設定する。
            m_DayTable(j) = m_DayTable(j) Or STATE_ALTERNATE
        End If
    Next i
End Sub

Private Sub SetNationalHoliday()
    Dim i As Long
    Dim j As Long
    Dim rc As Long
    
    For i = LBound(m_DayTable) To UBound(m_DayTable) - 2    '１月１日から年末-２日まで処理（年をまたぐ場合は考慮していない）
        '休日に挟まれている場合のみ処理
        If m_DayTable(i) = STATE_HOLIDAY And m_DayTable(i + 2) = STATE_HOLIDAY Then
            '国民の休日に設定する。
            m_DayTable(i + 1) = m_DayTable(i + 1) Or STATE_NATIONAL_HOLIDAY
        End If
    Next i
End Sub

Private Function IsLeapYear() As Boolean
    If m_Year < 0 Then
        IsLeapYear = False
        Exit Function
    End If
    'うるう年のチェック
    IsLeapYear = False
    If m_Year Mod 4 = 0 Then
        IsLeapYear = True
        If m_Year Mod 100 = 0 Then
            IsLeapYear = False
            If m_Year Mod 400 = 0 Then
                IsLeapYear = True
            End If
        End If
    End If
End Function

Private Function GetSpringDay(nYear As Integer) As Integer
'
' 春分の日の取得
'
    Dim rc As Long
    
    '固定日付で指定されている分から取得する。
    rc = GetSpringDayFromList(nYear)
    If (rc > 0) Then
        GetSpringDay = rc
        Exit Function
    End If
    '固定日付で指定されていない場合は、計算式にて算出する。
    rc = nYear Mod 4
    If rc < 2 Then
        GetSpringDay = 20
    Else
        GetSpringDay = 21
    End If
End Function

Private Function GetSpringDayFromList(nYear As Integer) As Integer
'
' 春分の日（固定指定）
'
    '固定日付
    Select Case nYear
    Case 2009
        GetSpringDayFromList = 20
    Case 2010
        GetSpringDayFromList = 21
    Case 2011
        GetSpringDayFromList = 21
    Case 2012
        GetSpringDayFromList = 20
    Case 2013
        GetSpringDayFromList = 20
    Case 2014
        GetSpringDayFromList = 21
    Case Else
        GetSpringDayFromList = 0
    End Select
End Function

Private Function GetAutumnDay(nYear As Integer) As Integer
'
' 秋分の日の取得
'
    Dim rc As Long
    
    '固定日付で指定されている分から取得する。
    rc = GetAutumnDayFromList(nYear)
    If (rc > 0) Then
        GetAutumnDay = rc
        Exit Function
    End If
    '固定日付で指定されていない場合は、計算式にて算出する。
    rc = nYear Mod 4
    If rc = 0 Then
        GetAutumnDay = 22
    Else
        GetAutumnDay = 23
    End If
End Function

Private Function GetAutumnDayFromList(nYear As Integer) As Integer
'
' 秋分の日（固定指定）
'
    '固定日付
    Select Case nYear
    Case 2009
        GetAutumnDayFromList = 23
    Case 2010
        GetAutumnDayFromList = 23
    Case 2011
        GetAutumnDayFromList = 23
    Case 2012
        GetAutumnDayFromList = 22
    Case 2013
        GetAutumnDayFromList = 23
    Case 2014
        GetAutumnDayFromList = 23
    Case Else
        GetAutumnDayFromList = 0
    End Select
End Function

Private Sub ListDayTable()
'
' デバッグ用
'
    Dim i As Long
    Dim TargetDate As Date
    
    For i = LBound(m_DayTable) To UBound(m_DayTable)
        If m_DayTable(i) <> 0 Then
            TargetDate = m_Base + i
            Debug.Print TargetDate & "(" &am; m_DayTable(i) & ")"
        End If
    Next i
End Sub

Private Sub Class_Terminate()
    'ListDayTable
End Sub

Public Function IsWeekday(nMonth As Integer, nDay As Integer) As Boolean
'
' 指定された月日が平日（土・日・祝日・振替休日・国民の日以外）の場合、Trueを返す。
'
    Dim TargetDate As Date
    Dim idx As Long
    
    TargetDate = m_Year & "/" & nMonth & "/" & nDay
    idx = TargetDate - m_Base
    If m_DayTable(idx) = STATE_WEEKDAY Then
        IsWeekday = True
    Else
        IsWeekday = False
    End If
End Function

Private Function IsStateday(nMonth As Integer, nDay As Integer, nState As Long, Optional DebugMsg As String = "") As Boolean
'
' 指定された月日のチェック
'
    Dim TargetDate As Date
    Dim idx As Long
    
    If m_Year < 0 Then
        IsStateday = False
        Exit Function
    End If
    '指定日付のチェック
    If Not IsValidDate(nMonth, nDay) Then
        IsStateday = False
        Exit Function
    End If
    
    TargetDate = m_Year & "/" & nMonth & "/" & nDay
    idx = TargetDate - m_Base
    If (m_DayTable(idx) And nState) <> 0 Then
        'Debug.Print DebugMsg & " " & nMonth & "/" & nDay
        IsStateday = True
    Else
        IsStateday = False
    End If
    
End Function

Public Function IsSaturday(nMonth As Integer, nDay As Integer) As Boolean
'
' 指定された月日が土曜日の場合、Trueを返す。
'
    IsSaturday = IsStateday(nMonth, nDay, STATE_SATURDAY, "SATURDAY")
End Function

Public Function IsSunday(nMonth As Integer, nDay As Integer) As Boolean
'
' 指定された月日が日曜の場合、Trueを返す。
'
    IsSunday = IsStateday(nMonth, nDay, STATE_SUNDAY, "SUNDAY")
End Function

Public Function IsHoliday(nMonth As Integer, nDay As Integer) As Boolean
'
' 指定された月日が休日（祝日・振替休日・国民の休日）の場合、Trueを返す。
'
    IsHoliday = IsStateday(nMonth, nDay, (STATE_HOLIDAY Or STATE_ALTERNATE Or STATE_NATIONAL_HOLIDAY), "HOLIDAY")
End Function

Public Function IsWorkingHoliday(nMonth As Integer, nDay As Integer) As Boolean
'
' 指定された月日が休日（祝日・振替休日・国民の休日・社休日）の場合、Trueを返す。
'
    IsWorkingHoliday = IsStateday(nMonth, nDay, (STATE_HOLIDAY Or STATE_ALTERNATE Or STATE_NATIONAL_HOLIDAY Or STATE_USER_HOLIDAY), "USER")
End Function

Public Property Get DayCount() As Long
    If m_Year < 0 Then
        DayCount = 0
        Exit Property
    End If
    DayCount = UBound(m_DayTable)
End Property

Public Property Get Leap() As Boolean
    If m_Year < 0 Then
        Leap = False
        Exit Property
    End If
    If UBound(m_DayTable) = 366 Then
        Leap = True
    Else
        Leap = False
    End If
End Property

Public Function AddUserHoliday(nMonth As Integer, nDay As Integer) As Boolean
    Dim idx As Long
    Dim TargetDate As Date
    
    '指定日付のチェック
    If Not IsValidDate(nMonth, nDay) Then
        AddUserHoliday = False
        Exit Function
    End If
    
    TargetDate = m_Year & "/" & nMonth & "/" & nDay
    idx = TargetDate - m_Base                        'ベース日付分を引くとインデックスとなる。
    m_DayTable(idx) = m_DayTable(idx) Or STATE_USER_HOLIDAY
End Function

Private Function GetMonthDay(nMonth As Integer) As Long
'
' 月末日付の取得
'
    Dim MonthDayTbl()
    
    MonthDayTbl = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
    If UBound(m_DayTable) = 366 Then
        MonthDayTbl(1) = 29
    End If
    GetMonthDay = MonthDayTbl(nMonth - 1)
End Function

Private Function IsValidDate(nMonth As Integer, nDay As Integer) As Boolean
    If m_Year < 0 Then
        IsValidDate = False
        Exit Function
    End If
    '指定された月のチェック
    If nMonth < 1 Or nMonth > 12 Then
        IsValidDate = False
        Exit Function
    End If
    '指定された日のチェック
    If nDay < 1 Or nDay > GetMonthDay(nMonth) Then
        IsValidDate = False
        Exit Function
    End If
    IsValidDate = True
End Function